Mangrove Kingfisher & Red-capped Robin-chat: Untitled

Show code

library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(kableExtra)
library(plotly)
library(GeoLocTools)
setupGeolocation()
knitr::opts_chunk$set(echo = FALSE)
load(paste0("../data/1_pressure/", params$gdl_id, "_pressure_prob.Rdata"))
load(paste0("../data/2_light/", params$gdl_id, "_light_prob.Rdata"))
load(paste0("../data/3_static/", params$gdl_id, "_static_prob.Rdata"))
load(paste0("../data/5_wind_graph/", params$gdl_id, "_wind_graph.Rdata"))
col <- rep(RColorBrewer::brewer.pal(8, "Dark2"), times = ceiling(max(pam$sta$sta_id) / 8))

Settings used

All the results produced here are generated with (1) the raw geolocator data, (2) the labeled files of pressure and light and (3) the parameters listed below.

Show code

kable(gpr) %>% scroll_box(width = "100%")

gdl_id	keep	multisensor	description	crop_start	crop_end	thr_dur	extent_N	extent_W	extent_S	extent_E	map_scale	map_max_sample	map_margin	prob_map_s	prob_map_s_calib	prob_map_thr	shift_k	kernel_adjust	calib_lon	calib_lat	calib_1_start	calib_1_end	calib_2_start	calib_2_end	calib_2_lon	calib_2_lat	prob_light_w	thr_prob_percentile	thr_gs	thr_as	low_speed_fix	ringNo	scientific_name	common_name	mass	wing_span	Color
24TA	TRUE	TRUE	ok	2020-08-20	2021-06-10	0	0	34	-16	42	10	300	40	0.7	NA	0.9	0	1.4	39.9889	-3.37827	2020-08-20	2020-11-01	2021-05-08	2021-06-10	NA	NA	0.09	0.9	120	100	15	NA	Cossypha natalensis	Red-capped Robin-Chat	34.2	35	#EBC344

Pressure timeserie

The labeling of pressure data is illustrated with this figure. The black dots indicates the pressure datapoint not considered in the matching. Each stationary period is illustrated by a different colored line.

Show code

pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutlier | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutlier), aes(x = date, y = obs), colour = "black") +
  # geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie) %>% filter(sta_id > 0), aes(x = date, y = pressure0, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Pressure calibration

Show code

pressure_ts_bind <- do.call("rbind", shortest_path_timeserie) %>%
  filter(!is.na(sta_id))

pam$pressure %>%
  left_join(pressure_ts_bind %>% dplyr::select(c("date", "pressure0")), by = "date") %>%
  mutate(diff = ifelse(is.na(pressure0), 0, obs - pressure0)) %>%
  filter(sta_id > 0 & !isoutlier) %>%
  group_by(sta_id) %>%
  mutate(sta_id = paste0(sta_id, " (SD=", round(sd(diff), 2), " ; N=", n(), ")")) %>%
  ggplot(aes(x = diff)) +
  geom_histogram(aes(y = (..count..) / tapply(..count.., ..PANEL.., sum)[..PANEL..]), binwidth = .2) +
  facet_wrap(~sta_id) +
  scale_x_continuous(name = "Pressure Geolocator - best match ERA5 (hPa)") +
  scale_y_continuous(name = "Normalized histogram")

Light

Show code

raw_geolight <- pam$light %>%
  transmute(
    Date = date,
    Light = obs
  )
lightImage(tagdata = raw_geolight, offset = 0)
tsimagePoints(twl$twilight,
  offset = 0, pch = 16, cex = 1.2,
  col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
abline(v = gpr$calib_2_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_2_end, lty = 2, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_end, lty = 2, col = "firebrick", lwd = 1.5)

Show code

hist(z, freq = F)
lines(fit_z, col = "red")

The probability map resulting from light data alone can be seen below.

Show code

li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(light_prob))) {
  i_s <- metadata(light_prob[[i_r]])$sta_id
  info <- pam$sta[pam$sta$sta_id == i_s, ]
  info_str <- paste0(i_s, " | ", info$start, "->", info$end)
  li_s <- append(li_s, info_str)
  l <- l %>% addRasterImage(light_prob[[i_r]], opacity = 0.8, colors = "OrRd", group = info_str)
}
l %>%
  addCircles(lng = gpr$calib_lon, lat = gpr$calib_lat, color = "black", opacity = 1) %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Light vs Pressure

We can compare light and pressure location at long stationary stopover (>5 days). By assuming the best match of the pressure to be the truth, we can plot the histogram of the zenith angle and compare to the fit of kernel density at the calibration site.

Show code

raw_geolight <- pam$light %>%
  transmute(
    Date = date,
    Light = obs
  )
dur <- unlist(lapply(pressure_prob, function(x) difftime(metadata(x)$temporal_extent[2], metadata(x)$temporal_extent[1], units = "days")))
long_id <- which(dur > 5)

par(mfrow = c(2, 3))
for (i_s in long_id) {
  twl_fl <- twl %>%
    filter(!deleted) %>%
    filter(twilight > shortest_path_timeserie[[i_s]]$date[1] & twilight < tail(shortest_path_timeserie[[i_s]]$date, 1))
  sun <- solar(twl_fl$twilight)
  z_i <- refracted(zenith(sun, shortest_path_timeserie[[i_s]]$lon[1], shortest_path_timeserie[[i_s]]$lat[1]))
  hist(z_i, freq = F, main = paste0("sta_id=", i_s, " | ", nrow(twl_fl), "twls"))
  lines(fit_z, col = "red")
  xlab("Zenith angle")
}

Similarly, we can plot the line of sunrise/sunset at the best match of pressure (yellow line) and compare to the raw and labeled light data.

Show code

lightImage(
  tagdata = raw_geolight,
  offset = gpr$shift_k / 60 / 60
)
tsimagePoints(twl$twilight,
  offset = gpr$shift_k / 60 / 60, pch = 16, cex = 1.2,
  col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
for (ts in shortest_path_timeserie) {
  twl_fl <- twl %>%
    filter(twilight > ts$date[1] & twilight < tail(ts$date, 1))
  if (nrow(twl_fl) > 0) {
    tsimageDeploymentLines(twl_fl$twilight,
      lon = ts$lon[1], ts$lat[1],
      offset = gpr$shift_k / 60 / 60, lwd = 3, col = adjustcolor("orange", alpha.f = 0.5)
    )
  }
}

Stationay period information

Show code

pam$sta %>% kable()

sta_id	start	end
1	2020-08-20 00:00:00	2020-10-31 17:05:00
2	2020-10-31 18:00:00	2020-11-01 20:45:00
3	2020-11-01 21:15:00	2020-11-06 17:35:00
4	2020-11-06 23:50:00	2020-11-07 16:50:00
5	2020-11-08 00:15:00	2020-11-08 19:55:00
6	2020-11-09 00:05:00	2020-11-10 18:05:00
7	2020-11-11 01:20:00	2020-11-11 16:35:00
8	2020-11-12 00:55:00	2020-11-12 21:45:00
9	2020-11-13 01:10:00	2020-11-28 15:00:00
10	2020-11-28 15:05:00	2020-12-22 04:05:00
11	2020-12-22 04:10:00	2021-05-05 18:25:00
12	2021-05-06 02:20:00	2021-05-06 17:30:00
13	2021-05-06 20:40:00	2021-05-07 00:20:00
14	2021-05-07 01:45:00	2021-05-08 00:30:00
15	2021-05-08 02:10:00	2021-06-09 23:55:00

24TA - Red-capped Robin-Chat

Settings used

Pressure timeserie

Pressure calibration

Light

Light vs Pressure

Stationay period information